home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 51 / Amiga Format CD51 (2000-03-10)(Future Publishing)(GB)[!][issue 2000-04].iso / -serious- / programming / e / powerd / source / examples / raytrace.d < prev    next >
Text File  |  2000-01-27  |  21KB  |  856 lines
  1. // This example RayTraces an image and saves it in targa format as 24bit image
  2. // This example requires AGA and FPU
  3.  
  4. OBJECT Scene
  5.     Objects:PTR TO Object,
  6.     Lights:PTR TO Light,
  7.     Iar:FLOAT,                        // global ambient intensity
  8.     Iag:FLOAT,                        // global ambient intensity
  9.     Iab:FLOAT,                        // global ambient intensity
  10.     FogLength:FLOAT                // max visible distance in the fog
  11.  
  12. OBJECT Object
  13.     x:FLOAT,            // position for sphere, normal for plane
  14.     y:FLOAT,
  15.     z:FLOAT,
  16.     r:FLOAT,            // radius for sphere, offset for plane
  17.     ir:FLOAT,            // intensity (0-1)
  18.     ig:FLOAT,            // intensity (0-1)
  19.     ib:FLOAT,            // intensity (0-1)
  20.     ri:FLOAT,        // reflection intensity (0-1)
  21.     ra:FLOAT,        // ambient intensity (0-1)
  22.     h:UWORD,
  23.     type:UWORD,        // OT...
  24.     Next:PTR TO Object,
  25.     Surface:UWORD
  26.  
  27. OBJECT PolyObject
  28.     x:FLOAT,            // position for sphere, normal for plane
  29.     y:FLOAT,
  30.     z:FLOAT,
  31.     r:FLOAT,            // radius for sphere, offset for plane
  32.     ir:FLOAT,            // intensity (0-1)
  33.     ig:FLOAT,            // intensity (0-1)
  34.     ib:FLOAT,            // intensity (0-1)
  35.     ri:FLOAT,        // reflection intensity (0-1)
  36.     ra:FLOAT,        // ambient intensity (0-1)
  37.     h:UWORD,
  38.     type:UWORD,        // OT...
  39.     Next:PTR TO Object,
  40.     Surface:UWORD,
  41.     Poly:PTR TO Vector,
  42.     Count:LONG
  43.  
  44. OBJECT Light
  45.     x:FLOAT,
  46.     y:FLOAT,
  47.     z:FLOAT,
  48.     ir:FLOAT,            // intensity
  49.     ig:FLOAT,            // intensity
  50.     ib:FLOAT,            // intensity
  51.     Next:PTR TO Light
  52.  
  53. OBJECT Vector
  54.     x:FLOAT,
  55.     y:FLOAT,
  56.     z:FLOAT    
  57.  
  58. OBJECT Line
  59.     x|x0:FLOAT,
  60.     y|y0:FLOAT,
  61.     z|z0:FLOAT,
  62.     u|vx:FLOAT,
  63.     v|vy:FLOAT,
  64.     w|vz:FLOAT
  65.  
  66. OBJECT Plane
  67.     a:FLOAT,
  68.     b:FLOAT,
  69.     c:FLOAT,
  70.     d:FLOAT
  71.  
  72. OBJECT Intersection
  73.     nx:FLOAT,                // normala
  74.     ny:FLOAT,
  75.     nz:FLOAT,
  76.     x:FLOAT,                    // pozice
  77.     y:FLOAT,
  78.     z:FLOAT,
  79.     t:FLOAT                    // parametr
  80.  
  81. OBJECT RGB
  82.     r:UBYTE,
  83.     g:UBYTE,
  84.     b:UBYTE
  85.  
  86. OBJECT BGR                    // for targa saving
  87.     b:UBYTE,
  88.     g:UBYTE,
  89.     r:UBYTE
  90.  
  91. OBJECT RImage
  92.     Width:LONG,
  93.     Height:LONG,
  94.     Pixel:PTR TO RGB,
  95.     ZBuffer:PTR TO FLOAT,
  96.     Antialias:PTR TO UBYTE
  97.  
  98. ENUM    OT_Sphere,
  99.         OT_IPlane,            // infinite
  100.         OT_PolyObject
  101.  
  102. ENUM    SURFACE_None,
  103.         SURFACE_Stripes,
  104.         SURFACE_Checks,
  105.         SURFACE_Dots
  106.  
  107. PROC Gen(image:PTR TO RImage,rp:PTR TO RastPort)
  108.     DEFF    x,y,scene:PTR TO Scene,o:PTR TO Object,l:PTR TO Light
  109.     DEFF    r,g,b
  110.     DEF    ds:DateStamp,c
  111.     o:=[-100.0,-20.0,100.0, 20.0, 1.0,0.2,0.2, 0.0,0.1,6,OT_Sphere,NIL,SURFACE_None]:Object
  112.     o:=[ -60.0,-40.0,100.0, 10.0, 0.8,0.7,0.6, 0.0,1.0,4,OT_Sphere,o,SURFACE_None]:Object
  113.     o:=[   0.0,  0.0,  0.0, 40.0, 0.6,0.7,0.8, 0.0,1.0,5,OT_Sphere,o,SURFACE_None]:Object
  114.     o:=[ 120.0,  0.0,  0.0, 30.0, 1.0,1.0,1.0, 0.8,0.4,3,OT_Sphere,o,SURFACE_None]:Object
  115.     o:=[ -40.0, 20.0,100.0, 15.0, 0.4,0.6,0.8, 0.6,0.2,7,OT_Sphere,o,SURFACE_None]:Object
  116.     o:=[  20.0, 40.0, 60.0, 25.0, 0.8,0.6,0.4, 0.2,0.3,5,OT_Sphere,o,SURFACE_None]:Object
  117.     o:=[   0.0, -1.0,  0.1, 80.0, 0.0,0.3,0.6, 0.0,0.5,4,OT_IPlane,o,SURFACE_Checks]:Object
  118. //    o:=[   0.0,  0.0,  1.0, 70.0, 0.3,0.3,0.2, 0.0,0.5,4,OT_PolyObject,o,SURFACE_Stripes,[0.0,-50.0,0.0,80.0,-60.0,0.0,100.0,100.0,0.0,-50.0,50.0,0.0]:Vector,4]:PolyObject
  119.     l:=[ -60.0,-40.0,150.0,0.8,0.9,1.0,NIL]:Light
  120.     l:=[  80.0,-250.0,-150.0,0.6,0.6,0.6,l]:Light
  121.     l:=[ 120.0,-50.0,150.0,0.5,0.8,0.4,l]:Light
  122.     scene:=[o,l,0.0,0.0,0.0,10000.0]:Scene
  123.  
  124.     DateStamp(ds)
  125.     s_startday:=ds.Days
  126.     s_startmin:=ds.Minute
  127.     s_starttick:=ds.Tick
  128.  
  129.     FOR y:=-120.0 TO 119.0 STEP 1.0
  130.         FOR x:=-160.0 TO 159.0 STEP 1.0
  131.             r,g,b:=RayTrace(scene,[0.0,0.0,1000.0,x,y,-1000.0]:Line)
  132.             c:=RPlot(image,x+160,y+120,r,g,b)
  133.             IF rp
  134.                 SetAPen(rp,c)
  135.                 WritePixel(rp,x+160,y+120)
  136.             ENDIF
  137.         ENDFOR
  138.         IF Mouse()=3 THEN RETURN    // only to skip Antialias()
  139.         IF rp
  140.             SetAPen(rp,255)
  141.             WritePixel(rp,0,y+120)
  142.         ELSE DO PrintF('RayTracing: \d/\d\b',c:=y+120,image.Height)
  143.     ENDFOR
  144.     IF rp=NIL THEN PrintF('\n')
  145.  
  146.     Antialias(rp,image,scene)
  147.  
  148. //    DEFF    c
  149. //    c:=RayTrace(scene,[0.0,0.0,1000.0,0.0,-30.0,-1000.0]:Line)
  150. //    PrintF('$\z\h[8]\n',c)
  151.  
  152. ENDPROC
  153.  
  154. // here follows global statistical variables
  155. DEFL    s_raycount=0,
  156.         s_interattemps=0,
  157.         s_intersections=0,
  158.         s_raysinfog=0,
  159.         s_reflectedrays=0,
  160.         s_antialias4=0,
  161.         s_antialias9=0,
  162.         s_antialias16=0,
  163.         s_antialias25=0,
  164.         s_startday,s_startmin,s_starttick,
  165.         s_stopday,s_stopmin,s_stoptick
  166.  
  167. PROC RayTrace(scene:PTR TO Scene,line:PTR TO Line,level=0)(FLOAT,FLOAT,FLOAT)
  168.     DEF    object:PTR TO Object,
  169.             zobj=NIL:PTR TO Object,
  170.             light:PTR TO Light
  171.     DEFF    Ivr=0.0,                        // vysledna intenzita
  172.             Ivg=0.0,
  173.             Ivb=0.0,
  174.             Is=0.0,                        // intenzita zrcadlove slozky
  175.             q,qr,qg,qb
  176.     DEFF    t,tott=1000000.0,
  177.             tobj=NIL:PTR TO Object,
  178.             inter:Intersection
  179.     DEF    shadow:BOOL,n
  180.     DEF    r:Vector,    // reflected vector
  181.             l:Vector        // vector light-point
  182.     s_raycount++
  183.     object:=scene.Objects
  184.     WHILE object
  185.         s_interattemps++
  186.         IF object.type=OT_Sphere
  187.             t:=IntersectSphere(NIL,line,object)
  188.         ELSEIF object.type=OT_IPlane
  189.             t:=IntersectPlane(NIL,line,object)
  190.         ELSEIF object.type=OT_PolyObject
  191.             t:=IntersectPolyObject(NIL,line,object)
  192.         ENDIF
  193. //        PrintF('$\z\h[8],$\z\h[8]\n',t,object.r)
  194.         IF t
  195.             IF t<tott
  196.                 tott:=t
  197.                 tobj:=object
  198.             ENDIF
  199.         ENDIF
  200.         object:=object.Next
  201.     ENDWHILE
  202.     IF scene.FogLength
  203.         IF tott>scene.FogLength
  204.             s_raysinfog++
  205.             RETURN scene.Iar,scene.Iag,scene.Iab
  206.         ENDIF
  207.     ENDIF
  208.     IF tobj
  209.         s_intersections++
  210.         IF tobj.type=OT_Sphere
  211.             IntersectSphere(inter,line,tobj)
  212.         ELSEIF tobj.type=OT_IPlane
  213.             IntersectPlane(inter,line,tobj)
  214.         ELSEIF tobj.type=OT_PolyObject
  215.             IntersectPolyObject(inter,line,tobj)
  216.         ENDIF
  217. //        PrintF('      t: $\z\h[8],$\z\h[8]\n',tott,tobj.r)
  218. //        PrintF('normala: $\z\h[8],$\z\h[8],$\z\h[8]\n',inter.nx,inter.ny,inter.nz)
  219. //        PrintF(' pozice: $\z\h[8],$\z\h[8],$\z\h[8]\n',inter.x,inter.y,inter.z)
  220.         light:=scene.Lights
  221.         WHILE light
  222.             l.x:=light.x-inter.x
  223.             l.y:=light.y-inter.y
  224.             l.z:=light.z-inter.z
  225.             shadow:=FALSE
  226.             object:=scene.Objects
  227.             WHILE object
  228.                 IF object<>tobj
  229.                     s_interattemps++
  230.                     IF object.type=OT_Sphere
  231.                         t:=IntersectSphere(NIL,[inter.x,inter.y,inter.z,l.x,l.y,l.z]:Line,object)
  232.                     ELSEIF object.type=OT_IPlane
  233.                         t:=IntersectPlane(NIL,[inter.x,inter.y,inter.z,l.x,l.y,l.z]:Line,object)
  234.                     ELSEIF object.type=OT_PolyObject
  235.                         t:=IntersectPolyObject(NIL,[inter.x,inter.y,inter.z,l.x,l.y,l.z]:Line,object)
  236.                     ENDIF
  237. //                    PrintF('r $\z\h[8],$\z\h[8]\n',t,object.r)
  238.                     IF t
  239.                         s_intersections++
  240.                         shadow:=TRUE
  241.                     ENDIF
  242.                 ENDIF
  243.                 object:=object.Next
  244.             EXITIF shadow=TRUE
  245.             ENDWHILE
  246. //            PrintF('n')
  247. //            PrintF('normala: $\z\h[8],$\z\h[8],$\z\h[8],\d\n',inter.nx,inter.ny,inter.nz,shadow)
  248.             IF shadow=FALSE
  249.                 IF (q:=VectorAngle(inter,l))>0.0
  250.                     qr,qg,qb:=Surface(tobj.Surface,inter.x,inter.y,inter.z,tobj.ir,tobj.ig,tobj.ib)
  251.                     Ivr+=light.ir*q*qr
  252.                     Ivg+=light.ig*q*qg
  253.                     Ivb+=light.ib*q*qb
  254.                 ENDIF
  255.                 Reflect3D(r,inter,l)
  256.                 IF (q:=VectorAngle(r,[line.u,line.v,line.w]:Vector))>0.0
  257.                     IF tobj.h>1
  258.                         FOR n:=1 TO tobj.h
  259.                             q*=q
  260.                         ENDFOR
  261.                     ENDIF
  262.                     Ivr+=light.ir*q
  263.                     Ivg+=light.ig*q
  264.                     Ivb+=light.ib*q
  265.                 ENDIF
  266.             ENDIF
  267.             light:=light.Next
  268.         ENDWHILE
  269. //        PrintF('intensity: $\z\h[8],$\z\h[8]\n',Iv,tobj.r)
  270.         IF level<4
  271. //            PrintF(' object: $\z\h[8],$\z\h[8]\n',tobj.ri,tobj.r)
  272.             IF tobj.ri
  273.                 s_reflectedrays++
  274.                 Reflect3D(r,inter,[line.u,line.v,line.w]:Vector)
  275.                 qr,qg,qb:=RayTrace(scene,[inter.x,inter.y,inter.z,r.x,r.y,r.z]:Line,level+1)
  276.                 Ivr:=Ivr*(1.0-tobj.ri)/1.0+tobj.ri*qr/1.0
  277.                 Ivg:=Ivg*(1.0-tobj.ri)/1.0+tobj.ri*qg/1.0
  278.                 Ivb:=Ivb*(1.0-tobj.ri)/1.0+tobj.ri*qb/1.0
  279. //                PrintF('reflect: $\z\h[8],$\z\h[8]\n',q,Iv)
  280.             ENDIF
  281.         ENDIF
  282. //        PrintF('intensity: $\z\h[8],$\z\h[8]\n',Iv,tobj.r)
  283.         qr,qg,qb:=Surface(tobj.Surface,inter.x,inter.y,inter.z,tobj.ir,tobj.ig,tobj.ib)
  284.         Ivr+=scene.Iar*qr*tobj.ra
  285.         Ivg+=scene.Iag*qg*tobj.ra
  286.         Ivb+=scene.Iab*qb*tobj.ra
  287.         IF Ivr>1.0 THEN Ivr:=1.0
  288.         IF Ivr<0.0 THEN Ivr:=0.0
  289.         IF Ivg>1.0 THEN Ivg:=1.0
  290.         IF Ivg<0.0 THEN Ivg:=0.0
  291.         IF Ivb>1.0 THEN Ivb:=1.0
  292.         IF Ivb<0.0 THEN Ivb:=0.0
  293.         IF scene.FogLength
  294.             q:=tott/scene.FogLength
  295.             Ivr:=scene.Iar*q+Ivr*(1.0-q)
  296.             Ivg:=scene.Iag*q+Ivg*(1.0-q)
  297.             Ivb:=scene.Iab*q+Ivb*(1.0-q)
  298.         ENDIF
  299.         RETURN Ivr,Ivg,Ivb
  300.     ELSE
  301.         s_raysinfog++
  302.         RETURN scene.Iar,scene.Iag,scene.Iab
  303.     ENDIF
  304. ENDPROC 1.0,1.0,1.0
  305.  
  306. PROC VectorAngle(a:PTR TO Vector,b:PTR TO Vector)(FLOAT)
  307.     DEFF    r
  308.     r:=(a.x*b.x+a.y*b.y+a.z*b.z)/(Sqrt(a.x*a.x+a.y*a.y+a.z*a.z)*Sqrt(b.x*b.x+b.y*b.y+b.z*b.z))
  309. ENDPROC r
  310.  
  311. PROC VectorSize(a:PTR TO Vector)(FLOAT)
  312.     DEFF    r
  313.     r:=Sqrt(a.x*a.x+a.y*a.y+a.z*a.z)
  314. ENDPROC r
  315.  
  316. PROC ResizeVector(a:PTR TO Vector,l:FLOAT)
  317.     DEFF    d
  318.     d:=l/VectorSize(a)
  319. //    PrintF('$\z\h[8]\n',d)
  320.     a.x*=d
  321.     a.y*=d
  322.     a.z*=d
  323. ENDPROC
  324.  
  325. PROC LineDistance(line:PTR TO Line,point:PTR TO Vector)(FLOAT)
  326.     DEFF    plane:Plane,d,inter:Vector
  327.     plane.a:=line.vx                                // vytvoreni roviny kolme na danou primku
  328.     plane.b:=line.vy
  329.     plane.c:=line.vz
  330.     plane.d:=point.x*plane.a+point.y*plane.b+point.z*plane.c
  331.     plane.d:=-plane.d
  332. //    PrintF('$\z\h[8],$\z\h[8],$\z\h[8],$\z\h[8]\n',plane.a,plane.b,plane.c,plane.d)
  333.     PlaneIntersection(inter,line,plane)
  334. //    PrintF('$\z\h[8],$\z\h[8],$\z\h[8]\n',inter.x,inter.y,inter.z)
  335.     d:=PointDistance(inter,point)
  336. //    PrintF('$\z\h[8]\n',d)
  337. ENDPROC d
  338.  
  339. // tato funkce vypocita vzdalenost bodu od plochy v prostoru
  340. PROC PlaneDistance(plane:PTR TO Plane,point:PTR TO Vector)(FLOAT)
  341.     DEFF    a,b,c,d
  342.     a:=plane.a
  343.     b:=plane.b
  344.     c:=plane.c
  345.     d:=Sqrt(a*a+b*b+c*c)
  346.     IF d
  347.         d:=FAbs(a*point.x+b*point.y+c*point.z+plane.d)/d
  348.     ENDIF
  349. ENDPROC d
  350.  
  351. // tato funkce vypocita prusecik plochy a primky v prostoru
  352. PROC PlaneIntersection(dst:PTR TO Vector,line:PTR TO Line,plane:PTR TO Plane)(FLOAT,FLOAT,FLOAT)
  353.     DEFF    x,y,z,t,a,b,c
  354.     a:=plane.a
  355.     b:=plane.b
  356.     c:=plane.c
  357.     t:=(a*line.u+b*line.v+c*line.w)
  358. //    PrintF('$\z\h[8],$\z\h[8],$\z\h[8]\n',a,b,c)
  359.     IF t
  360.         t:=-(a*line.x0+b*line.y0+c*line.z0+plane.d)/t
  361.     ENDIF
  362.     x:=line.x0+line.u*t
  363.     y:=line.y0+line.v*t
  364.     z:=line.z0+line.w*t
  365. //    PrintF('$\z\h[8]\n',t)
  366. //    PrintF('$\z\h[8],$\z\h[8],$\z\h[8]\n',x,y,z)
  367.     IF dst
  368.         dst.x:=x
  369.         dst.y:=y
  370.         dst.z:=z
  371.     ENDIF
  372. ENDPROC x,y,z
  373.  
  374. // tatu funkce vraci parametr, na kterem dochazi k pruniku
  375. PROC PlaneIntersectionParameter(line:PTR TO Line,plane:PTR TO Plane)(FLOAT)
  376.     DEFF    t,a,b,c
  377.     a:=plane.a
  378.     b:=plane.b
  379.     c:=plane.c
  380. //    PrintF('a,b,c: $\z\h[8],$\z\h[8],$\z\h[8]\n',a,b,c)
  381.     t:=(a*line.u+b*line.v+c*line.w)
  382. //    PrintF('t1: $\z\h[8]\n',t)
  383.     IF t
  384. //        PrintF('t2: $\z\h[8]\n',t)
  385.         t:=-(a*line.x0+b*line.y0+c*line.z0+plane.d)/t
  386.         IF t<=0.0 THEN RETURN 0.0
  387.     ENDIF
  388. ENDPROC t
  389.  
  390. // tato funkce vypocita vzdalenost mezi dvema body v prostoru
  391. PROC PointDistance(a:PTR TO Vector,b:PTR TO Vector)(FLOAT)
  392.     DEFF    d,x,y,z
  393.     x:=b.x-a.x
  394.     y:=b.y-a.y
  395.     z:=b.z-a.z
  396.     d:=Sqrt(x*x+y*y+z*z)
  397. ENDPROC d
  398.  
  399. // tato funkce vypocita odrazeny vektor l podle normaly
  400. PROC Reflect3D(r:PTR TO Vector,n:PTR TO Vector,l:PTR TO Vector)(FLOAT,FLOAT,FLOAT)
  401.     DEFF    x,y,z,a
  402.     ResizeVector(n,1.0)
  403.     ResizeVector(l,1.0)
  404.     a:=2.0*(n.x*l.x+n.y*l.y+n.z*l.z)
  405.     x:=l.x-n.x*a
  406.     y:=l.y-n.y*a
  407.     z:=l.z-n.z*a
  408.     IF r
  409.         r.x:=x
  410.         r.y:=y
  411.         r.z:=z
  412.     ENDIF
  413. ENDPROC x,y,z
  414.  
  415. PROC IntersectSphere(inter:PTR TO Intersection,line:PTR TO Line,object:PTR TO Object)(FLOAT)
  416.     DEFF    d,t,plane:Plane,vector:Vector,l
  417.     d:=LineDistance(line,object)    // pozor, "object" je v tomto pripade to same jako bod
  418.     IF d<=object.r
  419.         // ano, koule je protnuta primkou
  420.         plane.a:=line.vx                                // vytvoreni roviny kolme na danou primku
  421.         plane.b:=line.vy
  422.         plane.c:=line.vz
  423.         plane.d:=object.x*plane.a+object.y*plane.b+object.z*plane.c
  424.         plane.d:=-plane.d
  425.         t:=PlaneIntersectionParameter(line,plane)
  426. //        PrintF('t=$\z\h[8]\n',t)
  427.         IF t>0.0
  428.             vector.x:=line.u*t
  429.             vector.y:=line.v*t
  430.             vector.z:=line.w*t
  431. //            PrintF(' vektor: $\z\h[8],$\z\h[8],$\z\h[8]\n',vector.x,vector.y,vector.z)
  432. //            PrintF('d $\z\h[8],$\z\h[8]\n',d,object.r)
  433.             l:=Sqrt(object.r*object.r-d*d)        // vzdalenost kraje koule po dane primce od bodu nejblizsiho ke stredu
  434. //            PrintF('l $\z\h[8],$\z\h[8]\n',l,object.r)
  435.             l:=VectorSize(vector)-l
  436. //            PrintF('l2$\z\h[8],$\z\h[8]\n',l,object.r)
  437.             IF inter
  438.                 ResizeVector(vector,l)
  439. //                PrintF('vektorP: $\z\h[8],$\z\h[8],$\z\h[8]\n',vector.x,vector.y,vector.z)
  440.                 inter.x:=vector.x+line.x0
  441.                 inter.y:=vector.y+line.y0
  442.                 inter.z:=vector.z+line.z0
  443. //                PrintF('  inter: $\z\h[8],$\z\h[8],$\z\h[8]\n',inter.x,inter.y,inter.z)
  444. //                PrintF(' objekt: $\z\h[8],$\z\h[8],$\z\h[8]\n',object.x,object.y,object.z)
  445.                 inter.t:=l
  446.                 inter.nx:=inter.x-object.x
  447.                 inter.ny:=inter.y-object.y
  448.                 inter.nz:=inter.z-object.z
  449. //                PrintF('normala: $\z\h[8],$\z\h[8],$\z\h[8]\n',inter.nx,inter.ny,inter.nz)
  450.             ENDIF
  451.             IF l>0.0 THEN RETURN l
  452.         ENDIF
  453.     ENDIF
  454. ENDPROC 0.0
  455.  
  456. PROC IntersectPlane(inter:PTR TO Intersection,line:PTR TO Line,object:PTR TO Object)(FLOAT)
  457.     DEFF    t,plane:Plane,vector:Vector,l
  458.     plane.a:=object.x
  459.     plane.b:=object.y
  460.     plane.c:=object.z
  461.     plane.d:=object.r
  462. //    PrintF('Yes: ')
  463.     t:=PlaneIntersectionParameter(line,plane)
  464. //    PrintF('Param: $\z\h[8]\n',t)
  465.     IF t>0.0
  466. //        PrintF('Yes($\z\h[8])\n',inter)
  467.         vector.x:=line.u
  468.         vector.y:=line.v
  469.         vector.z:=line.w
  470.         l:=VectorSize(vector)
  471.         IF inter
  472.             vector.x:=line.u*t
  473.             vector.y:=line.v*t
  474.             vector.z:=line.w*t
  475. //            ResizeVector(vector,l)
  476.             inter.x:=vector.x+line.x0
  477.             inter.y:=vector.y+line.y0
  478.             inter.z:=vector.z+line.z0
  479.             inter.t:=t*l
  480.             inter.nx:=object.x
  481.             inter.ny:=object.y
  482.             inter.nz:=object.z
  483.         ENDIF
  484.         t*=l
  485.     ELSE
  486.         t:=0.0
  487.     ENDIF
  488. ENDPROC t
  489.  
  490. PROC IntersectPolyObject(inter:PTR TO Intersection,line:PTR TO Line,object:PTR TO PolyObject)(FLOAT)
  491.     DEFF    t,plane:Plane,vector:Vector,l,point:Vector
  492.     plane.a:=object.x
  493.     plane.b:=object.y
  494.     plane.c:=object.z
  495.     plane.d:=object.r
  496. //    PrintF('Yes: ')
  497.     t:=PlaneIntersectionParameter(line,plane)
  498. //    PrintF('Param: $\z\h[8]\n',t)
  499.     IF t>0.0
  500.         vector.x:=line.u
  501.         vector.y:=line.v
  502.         vector.z:=line.w
  503.         l:=VectorSize(vector)
  504.         vector.x:=line.u*t
  505.         vector.y:=line.v*t
  506.         vector.z:=line.w*t
  507.         point.x:=vector.x+line.x0        // bod pruniku primky plochou
  508.         point.y:=vector.y+line.y0
  509.         point.z:=vector.z+line.z0
  510. //        PrintF('Pos: $\z\h[8],$\z\h[8]\n',line.u,line.v)
  511. //        IF IsPointInPoly(line.u,line.v,object.Poly,object.Count)=1
  512.         IF IsPointInPoly(point.x,point.y,object.Poly,object.Count)=1
  513. //            PrintF('Yes($\z\h[8])\n',l)
  514.             IF inter
  515.                 inter.x:=point.x
  516.                 inter.y:=point.y
  517.                 inter.z:=point.z
  518.                 inter.t:=t*l
  519.                 inter.nx:=object.x
  520.                 inter.ny:=object.y
  521.                 inter.nz:=object.z
  522.             ENDIF
  523.             t*=l
  524.         ELSE
  525.             t:=0.0
  526.         ENDIF
  527.     ELSE
  528.         t:=0.0
  529.     ENDIF
  530. ENDPROC t
  531.  
  532. // tahle funkce je vyrizla z AmiRaye a upravena
  533. PROC IsPointInPoly(x:FLOAT,y:FLOAT,p:PTR TO Vector,count)(BOOL)
  534.     DEF    n=0,e=0
  535.     DEFF    ys,x1,y1,x2,y2
  536.  
  537. //    PrintF('X,Y,C: $\z\h[8],$\z\h[8],\d\n',x,y,count)
  538.  
  539.     WHILE n<count
  540.         x1:=p[n].x
  541.         y1:=p[n].y
  542. //        PrintF('X1,Y2: $\z\h[8],$\z\h[8]\n',x1,y1)
  543.         IF n=(count-1)
  544.             x2:=p[0].x
  545.             y2:=p[0].y
  546.         ELSE
  547.             x2:=p[n+1].x
  548.             y2:=p[n+1].y
  549.         ENDIF
  550.  
  551.         IF (x1<=x AND x2>x) OR (x1>x AND x2<=x)
  552.         // x coord is between the two points
  553.             IF y1<=y AND y2<=y
  554.                 e++            // yes, there is line above the point
  555.             ELSEIF (y1<y AND y2>y) OR (y1>y AND y2<y)
  556.             // y coord is between the two points
  557.                 ys:=(x-x1)*((y2-p[n].y)/(x2-x1))+p[n].y
  558.                 IF ys<y THEN e++
  559.             ENDIF
  560.         ENDIF
  561.  
  562.         n++
  563.     ENDWHILE
  564. //    PrintF('Yes=\d\n',e)
  565. ENDPROC e&1
  566.  
  567. PROC Antialias(rp:PTR TO RastPort,image:PTR TO RImage,scene:PTR TO Scene)
  568.     DEFF    x,y,d,r,g,b
  569.     DEF    a:PTR TO UBYTE,n,i,j,ax,ay,c
  570.     IF a:=FindSharp(rp,image)
  571.         ay:=0
  572.         FOR y:=-120.0 TO 119.0 STEP 1.0
  573.             ax:=0
  574.             FOR x:=-160.0 TO 159.0 STEP 1.0
  575.                 n:=a[ay*320+ax]
  576.                 IF n
  577.                     d:=1/(n+1)
  578.                     r:=g:=b:=0.0
  579.                     FOR j:=0 TO n
  580.                         FOR i:=0 TO n
  581.                             r,g,b+=RayTrace(scene,[i*d,j*d,1000.0,x,y,-1000.0]:Line)
  582.                         ENDFOR
  583.                     ENDFOR
  584.                     d:=1/((n+1)*(n+1))
  585.                     r*=d
  586.                     g*=d
  587.                     b*=d
  588.                     c:=RPlot(image,ax,ay,r,g,b)
  589.                     IF rp
  590.                         SetAPen(rp,c)
  591.                         WritePixel(rp,ax,ay)
  592.                     ENDIF
  593.                 ENDIF
  594.                 ax++
  595.             ENDFOR
  596.             ay++
  597.             IF rp
  598.             ELSE DO PrintF('Antialiasing: \d/\d\b',ay,image.Height)
  599.         EXITIF Mouse()=3
  600.         ENDFOR
  601.         FreeVec(a)
  602.     ENDIF
  603.     IF rp=NIL THEN PrintF('\n')
  604. ENDPROC
  605.  
  606. PROC FindSharp(rp:PTR TO RastPort,image:PTR TO RImage)(PTR TO UBYTE)
  607.     DEF    x,y,c,a:PTR TO UBYTE
  608.     IF a:=AllocVec(320*240,MEMF_PUBLIC|MEMF_CLEAR)
  609.         DEF    min,max,dx,dy
  610.         IF rp THEN SetAPen(rp,255)
  611.         FOR y:=1 TO 238
  612.             FOR x:=1 TO 318
  613.                 min:=255
  614.                 max:=0
  615.                 FOR dy:=-1 TO 1
  616.                     FOR dx:=-1 TO 1
  617.                         c:=RGet(image,x+dx,y+dy)
  618.                         IF c<min THEN min:=c
  619.                         IF c>max THEN max:=c
  620.                     ENDFOR
  621.                 ENDFOR
  622.                 c:=max-min
  623.                 IF c>127
  624.                     c:=4
  625.                     s_antialias25++
  626.                 ELSEIF c>63
  627.                     c:=3
  628.                     s_antialias16++
  629.                 ELSEIF c>31
  630.                     c:=2
  631.                     s_antialias9++
  632.                 ELSEIF c>9
  633.                     c:=1
  634.                     s_antialias4++
  635.                 ELSE
  636.                     c:=0
  637.                 ENDIF
  638.                 IF rp
  639.                     IF c THEN WritePixel(rp,x,y)
  640.                 ENDIF
  641.                 a[y*320+x]:=c
  642.             ENDFOR
  643.         EXITIF Mouse()=3
  644.         ENDFOR
  645.     ENDIF
  646. ENDPROC a
  647.  
  648. PROC SaveTarga(image:PTR TO RImage)
  649.     DEF    buff:PTR TO BGR,f,x,y,length,comment:PTR TO CHAR
  650.     PrintF('Saving...           \n')
  651.     IF buff:=AllocMem(image.Width*image.Height*SIZEOF_BGR,MEMF_PUBLIC)
  652.         FOR y:=0 TO image.Height-1
  653.             FOR x:=0 TO image.Width-1
  654.                 buff[y*image.Width+x].r:=image.Pixel[y*image.Width+x].r
  655.                 buff[y*image.Width+x].g:=image.Pixel[y*image.Width+x].g
  656.                 buff[y*image.Width+x].b:=image.Pixel[y*image.Width+x].b
  657.             ENDFOR
  658.         ENDFOR
  659.         IF f:=Open('ram:image.tga',MODE_NEWFILE)
  660.             comment:='$VER:This picture is generated by Martin Kuchinka''s simple RayTracer.'
  661.             length:=StrLen(comment)
  662.             Write(f,[length,0,2,0,0,0,0,24,0,0,0,0,image.Width,image.Width>>8,image.Height,image.Height>>8,24,$20]:UBYTE,18)
  663.             Write(f,comment,length)
  664.             Write(f,buff,image.Width*image.Height*SIZEOF_BGR)
  665.             Close(f)
  666.         ELSE DO PrintF('Unable to write image!\n')
  667.         FreeMem(buff,image.Width*image.Height*SIZEOF_BGR)
  668.     ELSE DO PrintF('Not enough memory!\n')
  669. ENDPROC
  670.  
  671. PROC Surface(s,x:FLOAT,y:FLOAT,z:FLOAT,r:FLOAT,g:FLOAT,b:FLOAT)(FLOAT,FLOAT,FLOAT)
  672.     DEFF    l
  673.     SELECT s
  674.     CASE SURFACE_Stripes
  675.         y\=50
  676.         IF y<0
  677.             y:=FAbs(y)
  678.             IF y<25
  679.                 r/=2
  680.                 g/=2
  681.                 b/=2
  682.             ENDIF
  683.         ELSE
  684.             IF y>25
  685.                 r/=2
  686.                 g/=2
  687.                 b/=2
  688.             ENDIF
  689.         ENDIF
  690.     CASE SURFACE_Checks
  691.         x\=100
  692.         z\=100
  693.         IF x<0
  694.             x:=-x
  695.             IF z<0
  696.                 z:=-z
  697.                 IF (x>50 AND z>50) OR (x<50 AND z<50)
  698.                     r/=2
  699.                     g/=2
  700.                     b/=2
  701.                 ENDIF
  702.             ELSE
  703.                 IF (x>50 AND z<50) OR (x<50 AND z>50)
  704.                     r/=2
  705.                     g/=2
  706.                     b/=2
  707.                 ENDIF
  708.             ENDIF
  709.         ELSE
  710.             IF z<0
  711.                 z:=-z
  712.                 IF (x<50 AND z>50) OR (x>50 AND z<50)
  713.                     r/=2
  714.                     g/=2
  715.                     b/=2
  716.                 ENDIF
  717.             ELSE
  718.                 IF (x<50 AND z<50) OR (x>50 AND z>50)
  719.                     r/=2
  720.                     g/=2
  721.                     b/=2
  722.                 ENDIF
  723.             ENDIF
  724.         ENDIF
  725.     CASE SURFACE_Dots
  726.         x\=100
  727.         y\=100
  728.         z\=100
  729.         x-=50
  730.         y-=50
  731.         z-=50
  732.         l:=Sqrt(x*x+z*z)
  733.         IF l<25
  734.             r/=2
  735.             g/=2
  736.             b/=2
  737.         ENDIF
  738.     ENDSELECT
  739. ENDPROC r,g,b
  740.  
  741. PROC NewImage(w,h)(PTR TO RImage)
  742.     DEF    image:PTR TO RImage
  743.     IF (image:=AllocMem(SIZEOF_RImage,MEMF_PUBLIC|MEMF_CLEAR))=NIL THEN RETURN NIL
  744.     image.Width:=w
  745.     image.Height:=h
  746.     IF (image.Pixel:=AllocMem(SIZEOF_RGB*w*h,MEMF_PUBLIC|MEMF_CLEAR))=NIL
  747.         FreeMem(image,SIZEOF_RImage)
  748.         RETURN NIL
  749.     ENDIF
  750. ENDPROC image
  751.  
  752. PROC RPlot(image:PTR TO RImage,x,y,r:FLOAT,g:FLOAT,b:FLOAT/*,z=0.0:FLOAT*/)(LONG)
  753.     DEFF    c
  754.     r*=255
  755.     g*=255
  756.     b*=255
  757.     image.Pixel[y*image.Width+x].r:=r
  758.     image.Pixel[y*image.Width+x].g:=g
  759.     image.Pixel[y*image.Width+x].b:=b
  760. /*
  761.     IF image.ZBuffer
  762.         image.ZBuffer[y*image.Width+x]:=z
  763.     ENDIF
  764. */
  765.     c:=r+g+b
  766.     c/=3
  767. ENDPROC c
  768.  
  769. PROC RGet(image:PTR TO RImage,x,y)(LONG)
  770. //    DEF    c
  771. //    c:=image.Pixel[y*image.Width+x].r+image.Pixel[y*image.Width+x].g+image.Pixel[y*image.Width+x].b
  772.  
  773.     DEF    c,pixel:PTR TO RGB
  774.     pixel:=image.Pixel[y*image.Width+x]    // tohle v decku nefacha
  775.     c:=pixel.r+pixel.g+pixel.b
  776.  
  777.     c/=3
  778. ENDPROC c
  779.  
  780. PROC DeleteImage(image:PTR TO RImage)
  781.     IF image.Pixel THEN FreeMem(image.Pixel,image.Width*image.Height*SIZEOF_RGB)
  782.     FreeMem(image,SIZEOF_RImage)
  783. ENDPROC
  784.  
  785. PROC ShowInfo()
  786.     DEFF    f
  787.     DEF    str[24]:CHAR,ds:DateStamp,sec
  788.     DateStamp(ds)
  789.     s_stopday:=ds.Days
  790.     s_stopmin:=ds.Minute
  791.     s_stoptick:=ds.Tick
  792.     IF s_startday=s_stopday
  793.         sec:=s_stopmin*60+s_stoptick/50-s_startmin*60-s_starttick/50
  794.     ENDIF
  795.     PrintF('           Total rays: \d\n',s_raycount)
  796.     PrintF('       Reflected rays: \d\n',s_reflectedrays)
  797.     PrintF(' Intersection attemps: \d\n',s_interattemps)
  798.     PrintF('        Intersections: \d\n',s_intersections)
  799.     PrintF('     Rays lost in fog: \d\n',s_raysinfog)
  800.     PrintF('   Antialiased pixels:\n')
  801.     PrintF('       \d[2]x recomputed: \d\n',4,s_antialias4)
  802.     PrintF('       \d[2]x recomputed: \d\n',9,s_antialias9)
  803.     PrintF('       \d[2]x recomputed: \d\n',16,s_antialias16)
  804.     PrintF('       \d[2]x recomputed: \d\n',25,s_antialias25)
  805.     f:=320*240+(s_antialias4*4+s_antialias9*9+s_antialias16*16+s_antialias25*25)
  806.     f/=320*240
  807.     RealStr(str,f,4)
  808.     PrintF(' Each pixel was recomputed \s times.\n',str)
  809.     PrintF(' Rendering time: \d:\d (\d secs).\n',sec/60,sec\60,sec)
  810. ENDPROC
  811.  
  812. PROC main()
  813.     DEF    image:PTR TO RImage
  814.  
  815.     DEF    w:PTR TO Window,s:PTR TO Screen,vp,n
  816.     IF s:=OpenScreenTagList(NIL,[
  817.             SA_Width,320,
  818.             SA_Height,240,
  819.             SA_Depth,8,
  820.             SA_Title,'AmiRay Test Program',
  821. //            SA_DisplayID,VGALORESDBL_KEY,
  822.             SA_LikeWorkbench,TRUE,
  823.             TAG_END])
  824.         IF w:=OpenWindowTagList(NIL,[
  825.                 WA_InnerWidth,320,
  826.                 WA_InnerHeight,240,
  827.                 WA_Flags,WFLG_ACTIVATE|WFLG_RMBTRAP|WFLG_BORDERLESS|WFLG_GIMMEZEROZERO,
  828.                 WA_IDCMP,IDCMP_CLOSEWINDOW,
  829.                 WA_CustomScreen,s,
  830.                 TAG_END])
  831.             vp:=ViewPortAddress(w)
  832.             FOR n:=0 TO 255 DO SetRGB32(vp,n,n<<24,n<<24,n<<24)
  833.  
  834.             IF image:=NewImage(320,240)
  835.                 Gen(image,w.RPort)
  836. //                Gen(image,NIL)
  837.                 SaveTarga(image)
  838.                 ShowInfo()
  839.                 WaitPort(w.UserPort)
  840.                 DeleteImage(image)
  841.  
  842.             ENDIF
  843.             CloseWindow(w)
  844.         ELSE DO PrintF('unable to open window!\n')
  845.         CloseScreen(s)
  846.     ELSE DO PrintF('unable to open screen!\n')
  847. ENDPROC
  848.  
  849. MODULE    'intuition/intuition',
  850.             'intuition/screens',
  851.             'graphics/modeid',
  852.             'utility/tagitem'
  853. MODULE    'graphics/rastport'
  854. MODULE    'exec/memory',            // pro ukladani
  855.             'dos/dos'
  856.